home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / think-c / tc-edit-send.el next >
Encoding:
Text File  |  1994-03-08  |  12.3 KB  |  331 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; Apple event support for the Think Project Manager
  3. ;;;
  4.  
  5. (defun tc:send-parameterless (eventType description)
  6.   (let* (event
  7.          (reply (make-string sizeof-AppleEvent 0))
  8.          transactionID
  9.          (result
  10.           (catch 'panic
  11.             (throw-err (create-think-c-apple-event "KAHL" eventType
  12.                                                    event transactionID))
  13.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  14.                                kAENormalPriority 0 0 0))
  15.             (setq ae-history (cons (cons transactionID
  16.                                          (list (cons 'description description)
  17.                                                (cons 'handler 'do-simple-reply)))
  18.                                    ae-history))
  19.             noErr)))
  20.     (if event (AEDisposeDesc event))
  21.     result))
  22. ;
  23. ; -----------------------------------------------------------------------
  24. ; -----------------------------------------------------------------------
  25. ;
  26. ; Modified --- the editor sends this event to notify THINK that a file has been modified
  27. ;              at the specified time.  The editor should send this event when saving a
  28. ;              file and when closing a file.
  29. ;         
  30. ; Event Class:    'KAHL'
  31. ; Event ID:        'MOD '
  32. ; Parameters:
  33. ; 
  34. ;     keyDirectObject (AEDescList of the following structs (typeChar), one for each file)
  35. ;         struct {
  36. ;             FSSpec     fss;    //    the file spec
  37. ;             long    when;    //    the modified time
  38. ;             short    saved;    //    is the file being saved?  0 == no.
  39. ;         };
  40.  
  41. ; -----------------------------------------------------------------------
  42. ; -----------------------------------------------------------------------
  43. ;
  44. ; Find In Next File --- the editor sends this event to prompt THINK to execute its
  45. ;                       Find In Next File command.  This provides better THINK/Editor
  46. ;                       integration during multi-file searches.
  47. ;         
  48. ; Event Class:    'KAHL'
  49. ; Event ID:        'FINF'
  50. ; Parameters:        none
  51.  
  52. (defun tc:send-finf ()
  53.   (tc:send-parameterless "FINF" "find-in-next-file"))
  54.  
  55. ; -----------------------------------------------------------------------
  56. ; -----------------------------------------------------------------------
  57. ;
  58. ; Goto Next Match ---  the editor sends this event to prompt THINK to execute its
  59. ;                      Go To Next Match/Error command.  This provides better THINK/Editor
  60. ;                      integration during batch compiles and batch searches.
  61. ;         
  62. ; Event Class:    'KAHL'
  63. ; Event ID:        'NMAT'
  64. ; Parameters:        none
  65.  
  66. (defun tc:send-nmat ()
  67.   (tc:send-parameterless "NMAT" "goto-next-match"))
  68.  
  69. ; -----------------------------------------------------------------------
  70. ; -----------------------------------------------------------------------
  71. ;
  72. ; Goto Previous Match ---  the editor sends this event to prompt THINK to execute its
  73. ;                           Go To Previous Match/Error command.  This provides better 
  74. ;                           THINK/Editor integration during batch compiles and batch
  75. ;                           searches.
  76. ;         
  77. ; Event Class:    'KAHL'
  78. ; Event ID:        'PMAT'
  79. ; Parameters:        none
  80.         
  81. (defun tc:send-pmat ()
  82.   (tc:send-parameterless "PMAT" "goto-previous-match"))
  83.  
  84. ; -----------------------------------------------------------------------
  85. ; -----------------------------------------------------------------------
  86. ;
  87. ; Get Markers --- the editor sends this event to ask THINK for a file's marker and
  88. ;                 Debugger state data.  The editor should send this event whenever
  89. ;                 it opens a file.
  90. ;         
  91. ; Event Class:    'KAHL'
  92. ; Event ID:        'GTMK'
  93. ; Parameters:
  94. ; 
  95. ;     keyDirectObject (AEDescList of FSSpecs (typeFSS), one for each file)
  96. ;         Indicates the file(s) just opened.
  97. ;         
  98. ;     'CLBK' (typeChar, required)
  99. ;         Specifies callback functions to be used by THINK in getting the marker data.
  100. ;         
  101. ;         struct {
  102. ;             long GetNumLines;    //    Pointer to a function that returns the number of
  103. ;                                 //    lines in a file.
  104. ;             long GetCharPos;    //    Pointer to a function that returns the character
  105. ;                                 //    position for the first character in a given line
  106. ;                                 //     of a file.
  107. ;             long refcon;        //    A 32-bit data element that THINK will pass back as
  108. ;                                 //    the first parameter of the GetNumLines and GetCharPos
  109. ;                                 //    functions.                    
  110. ;         };    
  111. ;  
  112. ; Reply Parameters:
  113. ; 
  114. ;     keyDirectObject (AEDescList of the following structs (typeChar), one for each file)
  115. ;     
  116. ;         struct {
  117. ;             Handle     markers, breakpoints, dataviews, lineOffsets;
  118. ;             long **bkptIDs, **dtvuIDs, **bkptSizes, **dtvuSizes;
  119. ;         };
  120.  
  121. (defun tc:send-gtmk ()
  122.   (let* (event
  123.          (reply (make-string sizeof-AppleEvent 0))
  124.          transactionID
  125.          spec
  126.          (clbk-data (make-string 12 0))
  127.          (file-name (buffer-file-name))
  128.          (result
  129.           (catch 'panic
  130.             (throw-err (create-think-c-apple-event "KAHL" "GTMK"
  131.                                                    event transactionID))
  132.             (if (null file-name) (throw-err errAEEventNotHandled))
  133.             (throw-err (unix-filename-to-FSSpec file-name spec))
  134.             (throw-err (AEPutParamPtr event keyDirectObject typeFSS
  135.                                       spec (length spec)))
  136.             (encode-internal clbk-data 0 'unsigned-long tc:GetNumLines)
  137.             (encode-internal clbk-data 4 'unsigned-long tc:GetCharPos)
  138.             (encode-internal clbk-data 8 'verbatim-long (current-buffer))
  139.             (throw-err (AEPutParamPtr event "CLBK" typeChar
  140.                                       clbk-data (length clbk-data)))
  141.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  142.                                kAENormalPriority 0 0 0))
  143.             (setq ae-history (cons (cons transactionID
  144.                                          (list (cons 'description "get-markers")
  145.                                                (cons 'handler 'tc:do-gtmk-reply)
  146.                                                (cons 'buffer (current-buffer))))
  147.                                    ae-history))
  148.             noErr)))
  149.     (if event (AEDisposeDesc event))
  150.     result))
  151.  
  152. (defun tc:try-sending-gtmk ()
  153.   ;;; This will avoid settting tc:have-TPM-data if there is none at all to be had.
  154. ;  (if (tc:file-in-project-p (file-name-nondirectory
  155. ;                             (buffer-file-name (current-buffer)))))
  156.       (tc:send-gtmk))
  157.  
  158. ;;; "Whenever we open a file..."
  159. (if (not (memq (function tc:send-gtmk) find-file-hooks))
  160.     (setq find-file-hooks (cons (function tc:try-sending-gtmk) find-file-hooks)))
  161.  
  162. (defun tc:do-gtmk-reply (event history)
  163.   (let* ((theList (make-string sizeof-AEDesc 0))
  164.          (theCount-string (make-string sizeof-long 0))
  165.          theCount-integer
  166.          (theAEKeyword (make-string sizeof-long 0))
  167.          (typeCode (make-string sizeof-long 0))
  168.          (dataPtr (make-string (* 8 sizeof-long) 0))
  169.          (actualSize (make-string sizeof-long 0))
  170.          (result
  171.           (catch 'panic
  172.             (throw-err (AEGetParamDesc event keyDirectObject typeAEList theList))
  173.             (throw-err (AECountItems theList theCount-string))
  174.             (setq theCount-integer (extract-internal theCount-string 0 'long))
  175.             (if (not (= theCount-integer 1))
  176.                 errAEEventNotHandled
  177.               (throw-err (AEGetNthPtr theList 1 typeChar theAEKeyword
  178.                                       typeCode dataPtr (* 8 sizeof-int) actualSize))
  179.               (let ((buffer (cdr (assoc 'buffer history))))
  180.                 (set-buffer buffer)
  181.                 (setf-tc:markers (extract-internal dataPtr 0 'unsigned-long))
  182.                 (setf-tc:breakpoints (extract-internal dataPtr 4 'unsigned-long))
  183.                 (setf-tc:dataviews (extract-internal dataPtr 8 'unsigned-long))
  184.                 (setf-tc:lineOffsets (extract-internal dataPtr 12 'unsigned-long))
  185.                 (setf-tc:bkptIDs (extract-internal dataPtr 16 'unsigned-long))
  186.                 (setf-tc:dtvuIDs (extract-internal dataPtr 20 'unsigned-long))
  187.                 (setf-tc:bkptSizes (extract-internal dataPtr 24 'unsigned-long))
  188.                 (setf-tc:dtvuSizes (extract-internal dataPtr 28 'unsigned-long))
  189.                 (setq tc:oldSelStart (tc:selStart))
  190.                 (setq tc:oldSelEnd (tc:selEnd))
  191.                 (setq tc:oldTextLength (tc:textLen))
  192.                 (setq tc:oldNumLines (tc:numLines))
  193.                 (setq tc:oldLineStart (tc:lineStart))
  194.                 (setq tc:oldLineEnd (tc:lineEnd))
  195.                 (setq tc:have-TPM-data t))))
  196.           noErr))
  197.     (if theList (AEDisposeDesc theList))
  198.     result))
  199.         
  200. ; -----------------------------------------------------------------------
  201. ; -----------------------------------------------------------------------
  202. ;
  203. ; Put Markers --- the editor sends this event when it wants THINK to store marker and
  204. ;                 Debugger state data into a disk file.  The editor should send this
  205. ;                 event whenever it saves a file.
  206. ; 
  207. ; Event Class:    'KAHL'
  208. ; Event ID:        'PTMK'
  209. ; Parameters:
  210. ; 
  211. ;     keyDirectObject (AEDescList of the following structs (typeChar), one for each file)
  212. ;     
  213. ;         struct {
  214. ;             short     copyfile,     //    Are we making a copy of the file to a disk file of
  215. ;                                 //    a different name (like THINK's "Save A Copy As…")?
  216. ;                     newfile;    //    Are we creating a new disk file (vs. saving to an
  217. ;                                 //    old one?)
  218. ;             FSSpec     fss;        //    The file spec.
  219. ;             Handle     markers, breakpoints, dataviews, lineOffsets;    //    The marker and
  220. ;             long     **bkptIDs, **dtvuIDs, **bkptSizes, **dtvuSizes;    //    Debugger data.
  221. ;         };
  222.  
  223. (c:defstruct tc:struct-ptmk ((short copyfile)
  224.                              (short newfile)
  225.                              (FSSpec fss)
  226.                              (long markers)
  227.                              (long breakpoints)
  228.                              (long dataviews)
  229.                              (long lineOffsets)
  230.                              (long bkptIDs)
  231.                              (long dtvuIDs)
  232.                              (long bkptSizes)
  233.                              (long dtvuSizes)))
  234.  
  235. (defun tc:send-ptmk (copyfile newfile spec)
  236.   (let ((obj (make-string (c:sizeof 'tc:struct-ptmk) 0)))
  237.     (c:slotset 'tc:struct-ptmk obj 'copyfile copyfile)
  238.     (c:slotset 'tc:struct-ptmk obj 'newfile newfile)
  239.     (c:slotset 'tc:struct-ptmk obj 'fss spec)
  240.     (c:slotset 'tc:struct-ptmk obj 'markers (tc:markers))
  241.     (c:slotset 'tc:struct-ptmk obj 'breakpoints (tc:breakpoints))
  242.     (c:slotset 'tc:struct-ptmk obj 'dataviews (tc:dataviews))
  243.     (c:slotset 'tc:struct-ptmk obj 'lineOffsets (tc:lineOffsets))
  244.     (c:slotset 'tc:struct-ptmk obj 'bkptIDs (tc:bkptIDs))
  245.     (c:slotset 'tc:struct-ptmk obj 'dtvuIDs (tc:dtvuIDs))
  246.     (c:slotset 'tc:struct-ptmk obj 'bkptSizes (tc:bkptSizes))
  247.     (c:slotset 'tc:struct-ptmk obj 'dtvuSizes (tc:dtvuSizes))
  248.     (let (event
  249.           (reply (make-string sizeof-AppleEvent 0))
  250.           transactionID
  251.           (result
  252.            (catch 'panic
  253.              (throw-err (create-think-c-apple-event "KAHL" "PTMK"
  254.                                                     event transactionID))
  255.              (throw-err (AEPutParamPtr event keyDirectObject typeChar
  256.                                        obj (length obj)))
  257.              (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  258.                                 kAENormalPriority 0 0 0))
  259.              (setq ae-history (cons (cons transactionID
  260.                                           (list (cons 'description "put-markers")
  261.                                                 (cons 'handler 'do-simple-reply)))
  262.                                     ae-history))
  263.              noErr)))
  264.       (if event (AEDisposeDesc event))
  265.       result)))
  266.  
  267. ; -----------------------------------------------------------------------
  268. ; -----------------------------------------------------------------------
  269. ;
  270. ; Update Markers --- the editor sends this event when it needs THINK to update a file's
  271. ;                    marker and Debugger state information (this involves changing the
  272. ;                    marker locations to reflect the addition or deletion of characters
  273. ;                    at a given location in the file).  For some guidelines on when to
  274. ;                    send this event, refer to the MiniEdit source code.
  275. ;         
  276. ; Event Class:    'KAHL'
  277. ; Event ID:        'MKUP'
  278. ; Parameters:
  279. ; 
  280. ;     keyDirectObject (AEDescList of the following structs (typeChar), one for each file)
  281. ; 
  282. ;         struct {
  283. ;             Handle     markers, breakpoints, dataviews, lineOffsets, dtvuIDs;
  284. ;             long    oldSelStart, oldSelEnd, oldTextLength, 
  285. ;                     oldLineStart, oldLineEnd, oldNumLines,
  286. ;                     newTextLength, newNumLines, newSelEnd;
  287. ;             long    refcon;        //    A 32-bit data element that THINK will pass back as
  288. ;                                 //    the first parameter of the GetLineNum function.
  289. ;         };
  290. ;         
  291. ;     'CLBK' (typeChar, required)
  292. ;         Pointer to a callback function to be used by THINK in getting the marker data.
  293. ;         The function, GetLineNum, returns the line which contains a given
  294. ;         character position.
  295.  
  296. (defun tc:send-mkup (buffer)
  297.   (let ((mkup (make-mkup buffer)))
  298.     (if mkup
  299.         (let* (event
  300.                transactionID
  301.                (reply (make-string sizeof-AppleEvent 0))
  302.                (callback-data (encode-long-integer tc:GetLineNum))
  303.                (result
  304.                 (catch 'panic
  305.                   (throw-err (create-think-c-apple-event "KAHL" "MKUP" event transactionID))
  306.                   (throw-err (AEPutParamPtr event keyDirectObject typeChar mkup (length mkup)))
  307.                   (throw-err (AEPutParamPtr event "CLBK" typeChar callback-data sizeof-long))
  308.                   (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  309.                                      kAENormalPriority 0 0 0))
  310.                   (setq ae-history (cons (cons transactionID
  311.                                                (list (cons 'description "marker-update")
  312.                                                      (cons 'handler 'do-simple-reply)))
  313.                                          ae-history))
  314.                   noErr)))
  315.           (if event (AEDisposeDesc event))
  316.           result)))) 
  317.  
  318. ; -----------------------------------------------------------------------
  319. ; -----------------------------------------------------------------------
  320. ;
  321. ; CloseProject --- the editor can send this event in response to a CloseProject event 
  322. ;                  from THINK.  Sending this event tells THINK to complete its pending  
  323. ;                  Close Project command.
  324. ;     
  325. ; Event Class:    'KAHL'
  326. ; Event ID:        'CPRJ'
  327. ; Parameters:        none
  328.  
  329. (defun tc:send-cprj ()
  330.   (tc:send-parameterless "CPRJ" "close-project"))
  331.